home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / CUGUK / C005.ZIP / TAN.C < prev    next >
Text File  |  1990-01-19  |  3KB  |  101 lines
  1. /********************************************************************
  2.  * C Users Group (U.K) C Source Code Library File CUGLIB.005        *
  3.  * Inquiries to: M. Houston, 36 Whetstone Clo. Farquhar Rd.         *
  4.  * Edgbaston, Birmingham B15 2QN ENGLAND                *
  5.  ********************************************************************
  6.  * File name: tan.c
  7.  * Program name: library modules only
  8.  * Source of file: The Public Domain Software Library.
  9.  * Purpose: maths function
  10.  * Changes: <who what when & why major changes have been made>      
  11.  ********************************************************************/
  12.  
  13.  
  14. /***********************************************************
  15.  *               The TULSA IBM C BOARD                     *
  16.  *                   918-664-8737                          *
  17.  *             300/1200 XMODEM, 24 Hours                   *
  18.  **********************************************************/
  19.  
  20.  
  21.  
  22. #include "math.h"
  23. #include "errno.h"
  24.  
  25. extern int errno;
  26.  
  27. static double tansub();
  28.  
  29. double cotan(x)
  30. double x;
  31. {
  32.         double y;
  33.  
  34.         y = fabs(x);
  35.         if (y < 1.91e-152) {
  36.                 errno = ERANGE;
  37.                 if (x < 0.0)
  38.                         return -HUGE;
  39.                 else
  40.                         return HUGE;
  41.         }
  42.         return tansub(x,y,2);
  43. }
  44.  
  45. double tan(x)
  46. double x;
  47. {
  48.         return tansub(x, fabs(x), 0);
  49. }
  50.  
  51. #define P1 -0.13338350006421960681e+0
  52. #define P2 +0.34248878235890589960e-2
  53. #define P3 -0.17861707342254426711e-4
  54. #define Q0 +1.0
  55. #define Q1 -0.46671683339755294240e+0
  56. #define Q2 +0.25663832289440112864e-1
  57. #define Q3 -0.31181531907010027307e-3
  58. #define Q4 +0.49819433993786512270e-6
  59.  
  60. #define P(f,g) (((P3*g P2)*g P1)*g*f + f)
  61. #define Q(g) ((((Q4*g Q3)*g Q2)*g Q1)*g Q0)
  62.  
  63. #define YMAX 6.74652e09
  64.  
  65. static double tansub(x, y, flag)
  66. double x,y;
  67. {
  68.         double f, g, xn;
  69.         double xnum, xden;
  70.  
  71.         if (y > YMAX) {
  72.                 errno = ERANGE;
  73.                 return 0.0;
  74.         }
  75.         if (modf(x*0.63661977236758134308, &xn) >= 0.5)
  76.                 xn += (x < 0.0) ? -1.0 : 1.0;
  77.         f = (x - xn*1.57080078125) + xn*4.454455103380768678308e-6;
  78.         if (fabs(f) < 2.33e-10) {
  79.                 xnum = f;
  80.                 xden = 1.0;
  81.         } else {
  82.                 g = f*f;
  83.                 xnum = P(f,g);
  84.                 xden = Q(g);
  85.         }
  86.         flag |= ((int)xn & 1);
  87.         switch (flag) {
  88.         case 1:         /* A: tan, xn odd */
  89.                 xnum = -xnum;
  90.         case 2:         /* B: cotan, xn even */
  91.                 return xden/xnum;
  92.  
  93.         case 3:         /* C: cotan, xn odd */
  94.                 xnum = -xnum;
  95.         case 0:         /* D: tan, xn even */
  96.                 return xnum/xden;
  97.         }
  98.         return 0.0;
  99. }
  100.  
  101.